home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / utility / pl4019ax.zip / PWD.PL < prev    next >
Perl Script  |  1991-11-13  |  1KB  |  56 lines
  1. ;# pwd.pl - keeps track of current working directory in PWD environment var
  2. ;#
  3. ;# $Header: pwd.pl,v 4.0 91/03/20 01:26:03 lwall Locked $
  4. ;#
  5. ;# $Log:    pwd.pl,v $
  6. ;# Revision 4.0  91/03/20  01:26:03  lwall
  7. ;# 4.0 baseline.
  8. ;# 
  9. ;# Revision 3.0.1.2  91/01/11  18:09:24  lwall
  10. ;# patch42: some .pl files were missing their trailing 1;
  11. ;# 
  12. ;# Revision 3.0.1.1  90/08/09  04:01:24  lwall
  13. ;# patch19: Initial revision
  14. ;# 
  15. ;#
  16. ;# Usage:
  17. ;#    require "pwd.pl";
  18. ;#    &initpwd;
  19. ;#    ...
  20. ;#    &chdir($newdir);
  21.  
  22. package pwd;
  23.  
  24. sub main'initpwd {
  25.     if ($ENV{'PWD'}) {
  26.     local($dd,$di) = stat('.');
  27.     local($pd,$pi) = stat($ENV{'PWD'});
  28.     return if $di == $pi && $dd == $pd;
  29.     }
  30.     chop($ENV{'PWD'} = `pwd`);
  31. }
  32.  
  33. sub main'chdir {
  34.     local($newdir) = shift;
  35.     if (chdir $newdir) {
  36.     if ($newdir =~ m#^/#) {
  37.         $ENV{'PWD'} = $newdir;
  38.     }
  39.     else {
  40.         local(@curdir) = split(m#/#,$ENV{'PWD'});
  41.         @curdir = '' unless @curdir;
  42.         foreach $component (split(m#/#, $newdir)) {
  43.         next if $component eq '.';
  44.         pop(@curdir),next if $component eq '..';
  45.         push(@curdir,$component);
  46.         }
  47.         $ENV{'PWD'} = join('/',@curdir) || '/';
  48.     }
  49.     }
  50.     else {
  51.     0;
  52.     }
  53. }
  54.  
  55. 1;
  56.